home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / c64 / utilities / PromShellv2b.sfx / menu maker (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1990-02-12  |  6.8 KB  |  67 lines
  1. 5 rem menu maker 10/9/85 wcm
  2. 10 poke 45,0 :poke 46,96 :poke 55,0 :poke 56,160 :clr :rem restrict basic vars
  3. 20 def fnh(x)=int(x/256) :def fnl(x)=x-256*fnh(x)
  4. 30 poke 53280,12 :poke 53281,0
  5. 40 print "[147]" chr$(142) tab(15) "menu maker"
  6. 100 input "is this a 16k cartridge (y/n)  y[157][157][157]"; a$
  7. 105 en=16384 :if a$="y" then en=24576
  8. 110 input "enter border color (0-15)  0[157][157][157]"; x :if x<0 or x>15 then 110
  9. 115 poke 8264,x
  10. 120 input "enter background color (0-15)  0[157][157][157]"; x :if x<0 or x>15 then 120
  11. 125 poke 8269,x
  12. 130 input "enter character color (0-15)  1[157][157][157]"; x :if x<0 or x>15 then 130
  13. 135 x$="[144][159][156][158][129][149][150][151][152][153][154][155]" :poke 8579,asc(mid$(x$,x+1))
  14. 160 input "menu title (max 20)"; t$ :if len(t$)>20 then 160
  15. 170 x=int((20-len(t$))/2) :a$=left$("          ",x)+t$
  16. 180 mp=8610 :gosub 1000
  17. 190 cp=8960 :pn=1
  18. 200 print "" en-cp "bytes left in cartridge"
  19. 210 print "insert disk with program" pn
  20. 220 f$="" :input "filename (return to quit)"; f$ :if f$<>"" then 250
  21. 230 input "do you really want to quit"; a$ :if a$="y" then 500
  22. 240 goto 200
  23. 250 print "loading ..." :close 2 :close 15 :open 15,8,15,"i0" :open 2,8,2,f$
  24. 255 gosub 2000 :if e>0 then 200
  25. 260 get#2,a$ :a=0 :if a$<>"" then a=asc(a$)
  26. 270 get#2,a$ :b=0 :if a$<>"" then b=asc(a$)
  27. 280 la=a+256*b :tp=cp
  28. 290 get#2,a$ :a=0 :if a$<>"" then a=asc(a$)
  29. 300 poke tp,a :tp=tp+1 :ss=st :if tp<en and ss=0 then 290
  30. 310 close 2 :close 15 :if ss=0 then print "file too large!" :goto 200
  31. 320 input "is this a basic program"; a$ :if a$="y" then 350
  32. 330 x=la :input "exec addr (return=load addr)"; x :if x<0 or x>65535 then 330
  33. 340 ea=x :goto 400
  34. 350 if tp+24>en then print "file too large for basic boot!" :goto 200
  35. 355 la=2049 :ea=tp-cp+la
  36. 360 data 169,1,133,43,169,8,133,44,169,133,45,169
  37. 365 data 133,46,169,0,32,113,168,76,174,167
  38. 370 restore :for i=tp to tp+8 :read x :poke i,x :next :poke tp+9,fnl(ea)
  39. 380 for i=tp+10 to tp+12 :read x :poke i,x :next :poke tp+13,fnh(ea)
  40. 390 for i=tp+14 to tp+23 :read x :poke i,x :next :tp=tp+24
  41. 400 x=8448+8*pn :poke x,fnl(cp+24576) :poke x+1,fnh(cp+24576)
  42. 405 poke x+2,fnl(tp+24576) :poke x+3,fnh(tp+24576)
  43. 410 poke x+4,fnl(la) :poke x+5,fnh(la) :poke x+6,fnl(ea) :poke x+7,fnh(ea)
  44. 420 a$=f$ :print "menu entry (max 16, return=filename)"
  45. 425 input "  ";a$ :if a$="" or len(a$)>16 then 420
  46. 430 mp=8663+25*pn :gosub 1000
  47. 440 cp=tp :pn=pn+1 :if cp<en and pn<10 then 200
  48. 500 a=8907 :b=8657+25*pn :for i=0 to 47 :poke b+i,peek(a+i) :next
  49. 510 poke b,pn+6 :poke b+25,pn+8 :poke 8528,pn+10 :poke 8553,pn+11 :poke 8446,pn
  50. 520 print "hang on ..." :if cp<en then for i=cp to en-1 :poke i,255 :next
  51. 530 print "done making cartridge." :print "insert disk to save cartridge on."
  52. 540 a$="" :input "filename for save"; a$ :if a$="" or len(a$)>19 then 540
  53. 550 mp=8173 :gosub 1000 :if en<>24576 then poke 8158,64
  54. 560 print "saving ..." :open 15,8,15,"i0" :sys 8128
  55. 565 gosub 2000 :close 15 :if e=0 then 600
  56. 570 if e<>63 then 530
  57. 580 input "replace file"; a$ :if a$<>"y" then 530
  58. 590 open15,8,15,"s0:"+a$ :gosub 2000 :close 15 :if e>19 then 530
  59. 595 goto 560
  60. 600 print "you must reload this program" :print "to do another cartridge."
  61. 610 print "bye ..." :new
  62. 1000 if len(a$)>0 then for i=1 to len(a$) :poke mp+i-1,asc(mid$(a$,i)) :next
  63. 1010 return
  64. 2000 input#15,e,m$,t,s :if e>19 then print "error";
  65. 2010 if e>0 then print e; m$; t; s
  66. 2020 return
  67.